home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / demon.srx < prev    next >
Text File  |  2000-02-29  |  3KB  |  152 lines
  1. /*******************************\
  2. **  Demon v1.0 for Solitarexx  **
  3. **    by Michal Szafranski     **
  4. \*******************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"Demon v1.0"'
  8. wintex = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDTEXT 4 42 tex 6
  11. ADDCYCLE 7 7 '"7|10|13|15"' 2 '"Reserve cards"' 16
  12. ADDCYCLE 9 14 '"Inf.|Once|Twice|3 Times|4 Times|5 Times|6 Times"' 0 '"Rotate deck"' 14
  13. ADDCYCLE 11 14 '"3-2-1|One|Two|Three"' 3 '"Cards at once"' 15
  14. ADDBUTTON 12 10 "Abort"
  15. ADDTEXT 14 42 tex 6
  16. SELECTGUI 3
  17. SCREENSIZE 2 13 6 2
  18. DO i = 0 TO 3
  19.     NEWSTACK 7 0 0 i+2 1 2 1 12
  20.     stack.i = RESULT
  21.     NEWSTACK 4 0 i+2 i+2 0 2 0 1 1
  22.     base.i = RESULT
  23. END
  24. NEWSTACK 0 0 1 0 1 0 13
  25. deck = RESULT
  26. NEWSTACK 5 32+8+1 1 1 1 0 13 2 2
  27. waste = RESULT
  28. NEWSTACK 6 4+8+16 0 1 0 2 0 13
  29. help = RESULT
  30. ADDCARDS deck SHUFFLED
  31.  
  32. DO FOREVER
  33.     ACTION
  34.     PARSE VAR RESULT act rest
  35.     IF act = 1 THEN EXIT
  36.     IF act = 3 THEN CALL GAME
  37. END
  38.  
  39. GAME:
  40.     CLEANUP deck
  41.     SETGADGET 14 STR tex
  42.     SELECTGUI 4
  43.     sel = 0
  44.     time = 0
  45.     fin = 1
  46.     GETGADGET 9
  47.     gadtimes = RESULT
  48.     GETGADGET 11
  49.     gadcards = RESULT
  50.     ile. = 0
  51.     SELECT
  52.         WHEN gadcards = 0 THEN DO
  53.             ile.0 = 3
  54.             ile.1 = 2
  55.             ile.2 = 1
  56.         END
  57.         WHEN gadtimes = 0 THEN ile. = gadcards
  58.         OTHERWISE DO i = 0 TO gadtimes-1
  59.             ile.i = gadcards
  60.         END
  61.     END
  62.     GETGADGET 7
  63.     CARDSELECT deck RESULT*3+6
  64.     MOVECARDS deck help
  65.     CARDSELECT deck 1
  66.     MOVECARDS deck help REVERSE
  67.     CARDSELECT deck 1
  68.     PARSE VAR RESULT xx base xx
  69.     base = 13-base
  70.     MOVECARDS deck base.0 REVERSE
  71.     DO i=0 TO 3
  72.         CARDSELECT deck 1
  73.         MOVECARDS deck stack.i REVERSE
  74.     END
  75.     DO FOREVER
  76.         ACTION
  77.         PARSE VAR RESULT act stack sid card
  78.         IF act = 1 THEN EXIT
  79.         IF act = 2 THEN SELECT
  80.             WHEN sid = 0 THEN CALL DODECK
  81.             WHEN sel = 0 & card>0 & sid>4 THEN sel=stack
  82.             WHEN sel > 0 & (sel = stack | sid = 4) THEN CALL DOBASE
  83.             WHEN sel > 0 & sid = 7 THEN CALL DOSTACKS
  84.             OTHERWISE ERRBEEP
  85.         END
  86.         IF act = 3 THEN DO
  87.             SELECTGUI 3
  88.             RETURN
  89.         END
  90.     END
  91. RETURN
  92. DODECK:
  93.     sel=0
  94.     CARDSELECT deck ile.time
  95.     IF RESULT = '' THEN DO
  96.         CARDSELECT waste 52
  97.         MOVECARDS waste deck REVERSE
  98.         time = time+1
  99.     END
  100.     ELSE MOVECARDS deck waste REVERSE
  101. RETURN
  102. DOSTACKS:
  103.     CARDSELECT sel 0 RELATIVE
  104.     PARSE VAR RESULT kolors wars xx
  105.     WHICHCARD sel
  106.     PARSE VAR RESULT len lsel
  107.     IF lsel ~= 1 & lsel ~= len THEN RETURN
  108.     CARDSELECT stack 1
  109.     PARSE VAR RESULT kolor war xx
  110.     IF kolor = '' THEN DO
  111.         war = 1
  112.         kolor = 1
  113.         CARDSELECT help 1
  114.         IF RESULT~='' & sel ~= help THEN kolor=0
  115.     END
  116.     ELSE DO
  117.         kolor = (kolor+kolors) // 2
  118.         war = (war+base) // 13 - (wars+base) // 13
  119.     END
  120.     IF war = 1 & kolor = 1 THEN MOVECARDS sel stack ATONCE
  121.     ELSE ERRBEEP
  122.     sel = 0
  123. RETURN
  124. DOBASE:
  125.     IF sel~=stack THEN CALL CHBASE
  126.     ELSE DO i= 0 TO 3 UNTIL ok=0
  127.         stack = base.i
  128.         CALL CHBASE
  129.     END
  130.     IF ok=0 THEN DO
  131.         fin = fin +1
  132.         MOVECARDS sel stack
  133.         IF fin = 52 THEN SETGADGET 14 STR wintex
  134.     END
  135.     ELSE ERRBEEP
  136.     sel = 0
  137. RETURN
  138. CHBASE:
  139.     CARDSELECT sel 1
  140.     PARSE VAR RESULT kolors wars xx
  141.     wars = (wars+base) // 13
  142.     CARDSELECT stack 1
  143.     PARSE VAR RESULT kolor war xx
  144.     IF kolor = '' THEN DO
  145.         kolor = kolors
  146.         war = -1
  147.     END
  148.     ELSE war = (war+base) // 13
  149.     IF kolor = kolors & (wars - war) = 1 THEN ok = 0
  150.     ELSE ok = 1
  151. RETURN
  152.